home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / propage / genies / frenchgenies / rexx / redimensionneboites.pprx < prev    next >
Text File  |  1993-08-03  |  3KB  |  99 lines
  1. /*
  2. @BRedimensionneBoîtes @P @I Ecrit et © par Don Cox
  3. @IN'est pas du Domaine Publique. Tous Droits Réservés.
  4. Traduit par Fabien Larini le 22/07/93.
  5.  
  6. Ce Génie redimensionne les boîtes suivant un pourcentage, ainsi il modifie
  7. les marges, la bordure, les offsets, et les échelles. La taille de
  8. caractère n'est pas modifiée. Ne fonctionne pas avec les chaînes de boîtes.
  9. */
  10.  
  11. /*BoxResize*/
  12. /* This Genie resizes boxes by a percentage factor and sets the margins, frame weight, offset and image scale accordingly. Type is not resized as this genie is for individual boxes, not linked chains. (See the separate TextResize genie).
  13. Written by Don Cox */
  14.  
  15.  
  16. signal on error
  17. signal on syntax
  18. address command
  19. call SafeEndEdit.rexx()
  20. call ppm_AutoUpdate(0)
  21. cr="0a"x
  22.  
  23. counter=0
  24.  
  25.  
  26. do forever
  27.     box=ppm_ClickOnBox("Clickez dans les Boîtes à Redimensionner")
  28.     if box=0 then break
  29.     counter=counter+1
  30.     boxes.counter=box
  31.     call ppm_SelectBox(box)
  32. end
  33.  
  34. if counter=0 then exit_msg("Pas de Boîte Sélectionnée")
  35.  
  36. percent = ppm_GetUserText(6,"Pourcentage de l'Ancienne Taille")
  37. if percent = "" then exit_msg("Abandon Utilisateur")
  38. if ~(datatype(percent,n)) then exit_msg("Valeur Invalide")
  39. factor = abs(percent/100)
  40. if factor>10 then factor = 10
  41. if factor<0.1 then factor = 0.1
  42.  
  43. currentunits=ppm_GetUnits()
  44. call ppm_SetUnits(1)
  45.  
  46.  
  47. do i=1 to counter
  48.     box=boxes.i
  49.  
  50.     framedata = ppm_GetBoxFrameData(box)
  51.     parse var framedata linecolor "0a"x fillcolor "0a"x lineweight "0a"x linepattern "0a"x fillpattern
  52.     call ppm_SetBoxFrameData(box, linecolor, fillcolor, lineweight*factor, linepattern, fillpattern)
  53.  
  54.     margins = ppm_GetBoxMargins(box)
  55.     parse var margins mleft mtop mright mbottom
  56.     call ppm_SetBoxMargins(box,mleft*factor,mtop*factor, mright*factor, mbottom*factor)
  57.  
  58.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  59.     /* if text, ask. Maybe set font size, line spacing, tabs, etc  */
  60.     howbig = ppm_GetBoxSize(box)
  61.     boxwidth = word(howbig,1)
  62.     boxheight = word(howbig,2)
  63.     call ppm_SetBoxSize(box, boxwidth*factor, boxheight*factor)
  64.  
  65.     boxscale = ppm_GetBoxScale(box)
  66.     Xscale = word(boxscale,1)
  67.     Yscale = word(boxscale,2)
  68.     call ppm_SetBoxScale(box,Xscale*factor, Yscale*factor)
  69.  
  70.     offsets = ppm_GetBoxOffset(box)
  71.     Xoffset = word(offsets,1)
  72.     Yoffset = word(offsets,2)
  73.     call ppm_SetBoxOffset(box, Xoffset*factor, Yoffset*factor)
  74.  
  75.     end
  76.  
  77. call ppm_SetUnits(currentunits)
  78.  
  79. call exit_msg()
  80.  
  81. end
  82.  
  83. error:
  84. syntax:
  85.     do
  86.     exit_msg("Arrêt du Génie dû à l'erreur: "errortext(rc))
  87.     end
  88.  
  89. exit_msg:
  90.     do
  91.     parse arg message
  92.     if message ~= "" then
  93.     call ppm_Inform(1,message,)
  94.     call ppm_ClearStatus()
  95.     call ppm_AutoUpdate(1)
  96.     exit
  97.     end
  98.  
  99.